home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_2 / issue_06 / pistuff / piforth < prev    next >
Encoding:
Text File  |  1988-12-29  |  5.3 KB  |  180 lines
  1.   EMPTY 0 MODE  
  2.   100000 CONSTANT base 5 CONSTANT dp
  3.   0 CONSTANT fa
  4.   0 CONSTANT A 0 CONSTANT B 
  5.   0 CONSTANT X 0 CONSTANT Y
  6.   VARIABLE places 
  7.   VARIABLE pointer     0 pointer !
  8.   VARIABLE plusminus   0 plusminus !
  9.  
  10. ( Define 4 arrays )
  11. : A% 4 * A + ;        : B% 4 * B + ;
  12. : X% 4 * X + ;        : Y% 4 * Y + ;
  13.  
  14. ( Dimension space for 4 arrays ) 
  15. : DIM HERE TO A places @ 4 * ALLOT
  16.       HERE TO B places @ 4 * ALLOT
  17.       HERE TO X places @ 4 * ALLOT
  18.       HERE TO Y places @ 4 * ALLOT ;
  19.    
  20. ( Print ALL 5 digits from cell)
  21. : .CELL <# # # # # # #> TYPE SPACE ;
  22.  
  23. ( .PI prints final value)
  24. : .PI CR 0 Y% @ . ." ." places @ 1- 1 
  25.   DO I DUP Y% @ .CELL 13 MOD 0= 
  26.   IF 2 SPACES THEN LOOP CR ; 
  27.  
  28. ( INITialise A%[] & B%[] arrays )
  29. : INIT places @ 0 DO 
  30.   0  I A% !  0  I B% ! LOOP 1 0 B% ! 
  31.   0 pointer !   0 plusminus ! ; 
  32.  
  33. ( TAKE one cell from another ) 
  34. : TAKE + 2DUP < IF SWAP base + 
  35.    -: 1 ELSE - 0   THEN SWAP ;  
  36.  
  37. ( DIVide B%[] by number into B%[]. ) 
  38. : DIVB pointer @ DUP >R B% @  
  39.   OVER UM/MOD DUP R@ B% ! 0= 
  40.   IF 1 pointer +! THEN base * 
  41.   places @ R> 1+ 2DUP > IF DO I B% @ 
  42.   + OVER UM/MOD I B% ! base * LOOP 
  43.   ELSE 2DROP THEN 2DROP ;
  44.  
  45. ( DIVide B%[] by number into A%[] )
  46. : DIVA  0  places @  pointer @ 
  47.   1- DO I B% @ + OVER UM/MOD I A% ! 
  48.   base * LOOP 2DROP ;
  49.  
  50. ( Copy B%[] to A%[] ) 
  51. : B->A places @ 0 
  52.   DO I B% @ I A% ! LOOP ;
  53.  
  54. ( Add A%[] to X%[] ) 
  55. : ADDAX 0 0 places @ 1- DO I A% @ 
  56.   I X% @ + + base UM/MOD 
  57.   SWAP I X% ! -1 +LOOP DROP ;
  58.  
  59. ( Add X%[] to Y%[]. ) 
  60. : ADDXY 0 0 places @ 1- DO I X% @
  61.   I Y% @ + + base UM/MOD 
  62.   SWAP I Y% ! -1 +LOOP DROP ; 
  63.  
  64. ( Take A%[] from X%[]. ) 
  65. : TAKEAX 0 0 places @ 1-
  66.   DO I X% @ I A% @ ROT TAKE 
  67.   I X% ! -1 +LOOP DROP ; 
  68.  
  69. ( Times X%[] by number. ) 
  70. : TIMES 0 0 places @ 1- DO I X% @
  71.   2 PICK UM* + base UM/MOD 
  72.   SWAP I X% ! -1 +LOOP 2DROP ; 
  73.  
  74. ( Accumulate ARCTAN series in X%[] )
  75. : ACCUM 1 plusminus @ - DUP 
  76.   plusminus ! IF   ADDAX
  77.               ELSE TAKEAX THEN ;
  78.  
  79. ( Calculate Arctan )
  80. : ARCTAN DUP DUP INIT DIVB B->A
  81.   ACCUM 147 < IF DUP * 2 TO fa 
  82.   ELSE 1 TO fa THEN
  83.   1 BEGIN OVER DIVB fa + DUP 2 MOD 
  84.      IF DUP DIVA ACCUM 
  85.      THEN pointer @ places @ 1- > 
  86.   UNTIL 2DROP ;
  87.  
  88. ( Add all arctan series into Y%[]) 
  89. : PI 0 !TIME EMPTY 1- dp / 3 + 
  90.   places ! DIM places @ 0 
  91.        DO 0 I X% ! 0 I Y% ! LOOP 
  92.   8   ARCTAN 24 TIMES  ADDXY 
  93.   places @ 0 DO 0 I X% ! LOOP 
  94.   57  ARCTAN  8 TIMES  ADDXY 
  95.   places @ 0 DO 0 I X% ! LOOP 
  96.   239 ARCTAN  4 TIMES  ADDXY 
  97.   .PI CR ." Time:= " @TIME 
  98.   .TIME ." seconds" ;
  99. PROTECT
  100.  
  101. ( Typing 1000 PI will run the       )
  102. ( program, giving 1000 decimal      ) 
  103. ( places in about 33 seconds.       )
  104. ( 200 PI will give 200 places. etc  )
  105. ( Typing .PI will repeat a printout )
  106. ( of the number.                    )
  107. (                                   )
  108. ( FORTH addicts? IF will understand )
  109. (          ELSE will not understand )
  110. (          THEN read on anyway!     )
  111. ( The above  should give you a clue )
  112. ( that FORTH  is a bottom about     )
  113. ( chest language. Here are some     )
  114. ( comparisons between FORTH & BASIC )
  115. ( BASIC  LET X%[I] = 5              )
  116. ( FORTH  5 I X% !                   )
  117. ( BASIC  LET X%[I] = X%[I] +  A%[I] )
  118. ( FORTH  I X% @  I A% @  +   I X% ! )
  119. ( BASIC  LET pointer = pointer  + 1 )
  120. ( FORTH    1 pointer +!             )
  121. ( FORTH is based around loading and )
  122. ( storing onto and from a stack.    )
  123. ( @ means load onto the stack.      )
  124. ( ! means store from the stack.     )
  125. ( Eg. X @ Y @ + Z ! means load the  )
  126. ( values in X and Y onto the stack  )
  127. ( then add them together and store  )
  128. ( the result in Z.                  )
  129. ( WORDs or procedures are defined   )
  130. ( starting with a colon <:> and     )
  131. ( ending with a semicolon <;>      )
  132. ( Eg. in BASIC a procedure to make  )
  133. ( a beep might be as follows.       )
  134. ( DEFPROC_beep: VDU 7 :ENDPROC      )
  135. ( In FORTH would be                 )
  136. (                   : BEEP 7 VDU ;  )
  137. ( Typing PROC_beep in BASIC or BEEP )
  138. ( in FORTH would make a beep.       )
  139. ( Just as in BASIC where PROC_beep  )
  140. ( can be used in other procedures   )
  141. ( BEEP can be used in the definition)
  142. ( of other words in FORTH.  Eg.     )
  143. ( : NOISE 25 0   DO BEEP   LOOP ;   )
  144. ( Typing NOISE would make 25 beeps. )
  145. ( NOISE and BEEP become part of the )
  146. ( language and can be used just like)
  147. ( any other word in the language.   )
  148. ( FORTH is sometimes called a DIY   )
  149. ( language. You can define words to )
  150. ( do whatever you wish.             )
  151. ( The PI program is surprisingly    )
  152. ( only about 5 times faster than the)
  153. ( BASIC version. Compliment to BBC  )
  154. ( BASIC!! )
  155. ( FORTH gets faster when only a few )
  156. ( variables are used and most of the)
  157. ( other values are kept on the stack)
  158. ( The PI program uses a lot of      )
  159. ( variables so is not a good test of)
  160. ( the language.                     )
  161. ( Comments or REMs should be in     )
  162. ( brackets which are ignored by the )
  163. ( compiler.                         )
  164. ( This program should be FILELOADed )
  165. ( into RiscFORTH these comments will)
  166. ( be ignored.)
  167. ( A stand alone program is 28K long )
  168. ( 3K for the PI code and 25K for the)
  169. ( FORTH kernel. I would think that  )
  170. ( the size of the code is less than )
  171. ( the tokenised BASIC version. The  )
  172. ( 25K for the FORTH kernel is not   )
  173. ( excessive on a 1000K machine.     )
  174. ( It would seem that RiscFORTH      )
  175. ( produces fast compact code. I     )
  176. ( would be interested to know how   )
  177. ( fast and what size a compiled     )
  178. ( PASCAL, BASIC or C version of the )
  179. ( PI program would be? Any offers?  )
  180.